home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / PROC.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  38KB  |  1,163 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #define GEN
  11.  
  12. #include "hdr.h"
  13. #include "libhdr.h"
  14. #include "vars.h"
  15. #include "segment.h"
  16. #include "gvars.h"
  17. #include "ops.h"
  18. #include "type.h"
  19. #include "axqrp.h"
  20. #include "namp.h"
  21. #include "maincasp.h"
  22. #include "exprp.h"
  23. #include "dbxp.h"
  24. #include "miscp.h"
  25. #include "libp.h"
  26. #include "statp.h"
  27. #include "setp.h"
  28. #include "genp.h"
  29. #include "segmentp.h"
  30. #include "gmiscp.h"
  31. #include "smiscp.h"
  32. #include "gutilp.h"
  33. #include "procp.h"
  34.  
  35. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  36.  
  37.  
  38. void gen_subprogram_spec(Node proc_node)                /*;gen_subprogram_spec*/
  39. {
  40.     /* subprogram spec.
  41.      * Just reserve a code slot, and GENERATE the procedure object.
  42.      * If the spec occurs elsewhere than immediately in the declarative part
  43.      * of a compilation unit, it may need a relay set, but we don't know it
  44.      * yet. So, we must prepare for a dynamically elaborated procedure.
  45.      */
  46.  
  47.     int     save_current_code_segment;
  48.     Symbol    proc_name;
  49.     Tuple    predef_tuple;
  50.  
  51. #ifdef TRACE
  52.     if (debug_flag)
  53.         gen_trace_node("GEN_SUBPROGRAM_SPEC", proc_node);
  54. #endif
  55.  
  56.     proc_name   = N_UNQ(proc_node);
  57.     /*tag         = NATURE(proc_name);*/
  58.  
  59.     predef_tuple = (Tuple) MISC(proc_name);
  60.     if (predef_tuple != (Tuple)0) { /*predef */
  61.     }
  62.     else {
  63.         save_current_code_segment = CURRENT_CODE_SEGMENT;
  64.         CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, proc_name, SLOTS_CODE);
  65. #ifdef TRACE
  66.         if (list_code) {
  67.             to_gen(" ");
  68.             to_gen_unam("--------------------------------------",
  69.                 ORIG_NAME(proc_name), "--------------");
  70.             to_gen_int("     code slot # ", CURRENT_CODE_SEGMENT);
  71.             to_gen(" ");
  72.         }
  73. #endif
  74.  
  75.         if (CURRENT_LEVEL == 1) { /* No relay set needed */
  76.             next_global_reference_r(proc_name, CURRENT_CODE_SEGMENT, 0);
  77.         }
  78.         else {
  79.             next_local_reference(proc_name);
  80.         }
  81.         /* Empty segment */
  82.         CODE_SEGMENT_MAP = segment_map_put(CODE_SEGMENT_MAP,
  83.           CURRENT_CODE_SEGMENT, segment_new(SEGMENT_KIND_CODE, 0));
  84.         SPECS_DECLARED += 1;
  85.         if (!tup_mem((char *) proc_name, SUBPROG_SPECS)) {
  86.             SUBPROG_SPECS = tup_with(SUBPROG_SPECS, (char *) proc_name);
  87.         }
  88. #ifdef MACHINE_CODE
  89.         if (list_code) {
  90.             to_gen_unam("-------- end  ", ORIG_NAME(proc_name), 
  91.                 " -----------");
  92.         }
  93. #endif
  94.         CURRENT_CODE_SEGMENT = save_current_code_segment;
  95.         if (CURRENT_LEVEL != 1) {
  96.             gen(I_END);          /* Purge peep-hole */
  97.             subprog_patch_put(proc_name, PC() + 1);
  98.             gen_rc(I_PUSH_EFFECTIVE_ADDRESS, explicit_ref_0,
  99.               "subprog. template");
  100.             gen(I_CREATE_STRUC);
  101.             gen_s(I_UPDATE_AND_DISCARD, proc_name);
  102.         }
  103.     } /* PREDEF */
  104. }
  105.  
  106. /* Procedure elaboration */
  107.  
  108. void gen_subprogram(Node proc_node)                        /*;gen_subprogram*/
  109. {
  110.     /*
  111.      *   To generate code there are several delicate steps to perform, as
  112.      *   the output of that is not only the proper code to elaborate the
  113.      *   subprogram (which may even be reduced to nothing), but to produce
  114.      *   a new code statement, adding some information to the previous
  115.      *   code generation environment, and preserving the previous
  116.      *   environment by "burying" it in local variables.
  117.      *
  118.      *   Here is a summary of the steps for this procedure:
  119.      *
  120.      *   1) Assign a code slot number to the new procedure/function.
  121.      *      Note: if the corresponding subprogram spec has been compiled, the
  122.      *            code slot is already defined.
  123.      *
  124.      *   2) The relay set must be build. The current relay set is preserved,
  125.      *      and a variable is put into the relay set when it cannot be found
  126.      *      neither in the global nor the local reference map.
  127.      *
  128.      *   3) Compute offsets for the parameters, including offset for the
  129.      *      types of arrays, and for the value returned by a function.
  130.      *      The parameters are located below the stack frame pointer, but
  131.      *      room shall be left for the return informations
  132.      *
  133.      *   4) After preserving the previous environment, generate code for
  134.      *      the procedure/function in a new clean segment, starting with
  135.      *      the "catch-all" exception handler.
  136.      *
  137.      *   5) generate code to elaborate the procedure/function (if not
  138.      *      static)
  139.      *
  140.      *   6) restore previous environment
  141.      */
  142.  
  143.     Node     decl_node, stmt_node, handler_node;
  144.     Symbol    proc_name, fname, ftype, t_name, temp_name, name;
  145.     int        tag, fmode, save_current_code_segment;
  146.     int        simple_recursive_proc, has_separate_spec;
  147.     int        const_addr_size, parameter_offset;
  148.     unsigned int    location; /*OFFSET */
  149.     Fortup    ft1;
  150.     int        proc_code_segment, patch_addr;
  151.     Tuple    save_local_reference_map, save_relay_set, save_subprog_specs;
  152.     unsigned int    save_last_offset, save_max_offset;
  153.     Tuple    save_parameter_set, save_code_patch_set, save_data_patch_set;
  154.     Tuple    temp_relay_set, relay_table;
  155.     Segment    tseg, save_code_segment;
  156.     unsigned int roff;
  157.     int        i, dn, rn;
  158.     struct tt_subprog *tptr;
  159.  
  160.     const_addr_size = mu_size(mu_addr);
  161.     gen(I_END);  /* purge peep-hole buffer */
  162.  
  163.     /*
  164.      *-----
  165.      *  1.
  166.      */
  167.     stmt_node = N_AST1(proc_node);
  168.     decl_node = N_AST2(proc_node);
  169.     proc_name = N_UNQ(proc_node);
  170.     handler_node = N_AST4(proc_node);
  171.     tag         = NATURE(proc_name);
  172.  
  173. #ifdef TRACE
  174.     if (debug_flag)
  175.         gen_trace_symbol("GEN_SUBPROGRAM", proc_name);
  176. #endif
  177.  
  178.     /*
  179.      *-----
  180.      *  2.
  181.      */
  182.  
  183.     save_relay_set           = RELAY_SET;
  184.     save_local_reference_map = LOCAL_REFERENCE_MAP;
  185.     save_subprog_specs       = SUBPROG_SPECS;
  186.     save_last_offset         = LAST_OFFSET;
  187.     save_max_offset          = MAX_OFFSET;
  188.     save_parameter_set       = PARAMETER_SET;
  189.     save_code_patch_set      = CODE_PATCH_SET;
  190.     save_data_patch_set      = DATA_PATCH_SET;
  191.     save_code_segment        = CODE_SEGMENT;
  192.     save_current_code_segment= CURRENT_CODE_SEGMENT;
  193.  
  194.     RELAY_SET           = tup_new(0);
  195.     LOCAL_REFERENCE_MAP = tup_new(0);
  196.     SUBPROG_SPECS       = tup_new(0);
  197.     LAST_OFFSET         = -SFP_SIZE;
  198.     MAX_OFFSET          = 0;
  199.     PARAMETER_SET       = tup_new(0);
  200.     CODE_PATCH_SET      = tup_new(0);
  201.     DATA_PATCH_SET      = tup_new(0);
  202.     CODE_SEGMENT        = segment_new(SEGMENT_KIND_CODE, 0);
  203.     if (is_defined(proc_name)) { /* exists separate subprog spec */
  204.         CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, proc_name,
  205.           SLOTS_CODE_BORROWED);
  206.     }
  207.     else {
  208.         CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, proc_name, SLOTS_CODE);
  209.     }
  210.  
  211.     parameter_offset = -const_addr_size;
  212.     FORTUP(fname = (Symbol), SIGNATURE(proc_name), ft1);
  213.         fmode = NATURE(fname);
  214.         ftype = TYPE_OF(fname);
  215.         if (!tup_mem((char *)fname, PARAMETER_SET)) {
  216.             PARAMETER_SET = tup_with(PARAMETER_SET, (char *) fname);
  217.         }
  218.         if (is_array_type(ftype)) {
  219.             /* Array addresses are mu_dble */
  220.             /*t_name= fname+'_type'; $ associate name*/
  221.             t_name= new_unique_name("fname_type");
  222.             assoc_symbol_put(fname, FORMAL_TEMPLATE, t_name);
  223.             local_reference_map_put(t_name, parameter_offset);
  224.             parameter_offset           -= const_addr_size;
  225.             if (!tup_mem((char *) t_name, PARAMETER_SET)) {
  226.                 PARAMETER_SET = tup_with(PARAMETER_SET, (char *) t_name);
  227.             }
  228.         }
  229.         local_reference_map_put(fname, (int) parameter_offset);
  230.         parameter_offset          -= const_addr_size;
  231.         if ((is_simple_type(ftype) &&  (fmode != na_in))) {
  232.             /* scalar out and in out parameters takes 2 stacks locations */
  233.             /* one for returned na_out value, the other for temporary na_in */
  234.             parameter_offset -= const_addr_size;
  235.         }
  236.     ENDFORTUP(ft1);
  237.  
  238.     if (tag == na_function ||
  239.       tag == na_function_spec  ) { /* temporary kludge */
  240.         parameter_offset = parameter_offset + const_addr_size
  241.           - mu_size(kind_of(TYPE_OF(proc_name)));
  242.         t_name = new_unique_name("return_temp");
  243.         /* associated name */
  244.         assoc_symbol_put(proc_name, RETURN_TEMPLATE, t_name);
  245.         generate_object(t_name);
  246.         if (!tup_mem((char *)t_name, PARAMETER_SET)) {
  247.             PARAMETER_SET  = tup_with(PARAMETER_SET, (char *) t_name);
  248.         }
  249.         local_reference_map_put(t_name, (int) parameter_offset);
  250.     }
  251.  
  252. #ifdef MACHINE_CODE
  253.     if (list_code) {
  254. #ifdef TBSN
  255.         f_nam